home *** CD-ROM | disk | FTP | other *** search
- /*****************************************************************************
- * "Irit" - the 3d (not only polygonal) solid modeller. *
- * *
- * Written by: Gershon Elber Ver 0.2, Mar. 1990 *
- ******************************************************************************
- * Module to evaluate the binary tree generated by the InptPrsr module. *
- * All the objects are handled the same but the numerical one, which is *
- * moved as a RealType and not as an object (only internally within this *
- * module) as it is frequently used and consumes much less memory this way. *
- * Note this module is par of InptPrsr module and was splited only because *
- * of text file sizes problems... *
- *****************************************************************************/
-
- #include <stdio.h>
- #include <ctype.h>
- #include <math.h>
- #include <string.h>
- #include "program.h"
- #include "ctrl-brk.h"
- #include "objects.h"
- #include "allocate.h"
- #include "inptprsg.h"
- #include "inptprsl.h"
- #include "windows.h"
-
- static int
- GlblDebugFuncLevel = 0;
-
- static void RebindVariable(ParseTree *Root, IPObjectStruct *PObj, int FreeOld);
- static ParseTree *InptEvalFetchExpression(ParseTree *Root, int i, int n);
- static int InptEvalCountNumExpressions(ParseTree *Root);
- static void InptEvalDeleteFunc(UserDefinedFuncDefType *UserFunc,
- int DeleteSelf);
-
- /*****************************************************************************
- * DESCRIPTION: M
- * Prints help on the given subject HelpHeader. M
- * A match is if the HelpHeader isa prefix of help file line. M
- * *
- * PARAMETERS: M
- * HelpHeader: Subject of help needed. M
- * *
- * RETURN VALUE: M
- * void M
- * *
- * KEYWORDS: M
- * InptEvalPrintHelp M
- *****************************************************************************/
- void InptEvalPrintHelp(char *HelpHeader)
- {
- static char
- *DefaultHelp = NULL;
- int i;
- char *Path, s[LINE_LEN];
- FILE *f;
-
- Path = searchpath(GlblHelpFileName);
-
- if (DefaultHelp == NULL)
- DefaultHelp = IritStrdup("Commands");
-
- if (strlen(HelpHeader) == 0)
- HelpHeader = DefaultHelp; /* Print a list of all commands. */
-
- if ((f = fopen(Path, "r")) == NULL) {
- sprintf(s, "Cannot open help file \"%s\".\n", GlblHelpFileName);
- WndwInputWindowPutStr(s);
- return;
- }
-
- for (i = 0; i < (int) strlen(HelpHeader); i++)
- if (islower(HelpHeader[i]))
- HelpHeader[i] = toupper(HelpHeader[i]);
-
- while (fgets(s, LINE_LEN-1, f) != NULL) {
- if (strncmp(HelpHeader, s, strlen(HelpHeader)) == 0) {
- /* Found match - print it. */
- while (fgets(s, LINE_LEN-1, f) != NULL && s[0] != '$') {
- if (s[strlen(s) - 1] < ' ')
- s[strlen(s) - 1] = 0; /* No CR/LF. */
-
- WndwInputWindowPutStr(&s[1]); /* Skip char 1. */
- }
- fclose(f);
- return;
- }
- }
-
- fclose(f);
-
- sprintf(s, "No help on %s\n", HelpHeader);
- WndwInputWindowPutStr(s);
- }
-
- /*****************************************************************************
- * DESCRIPTION: M
- * Compares two objects with comparison operator as in Root. M
- * *
- * PARAMETERS: M
- * Root: Type of comparison requested (=, <, >, etc.). M
- * Left, Right: Two objects to compare. M
- * IError: Type of error if was one. M
- * CError: Description of error if was one. M
- * *
- * RETURN VALUE: M
- * ParseTree *: Comparison result as a numeric value of >0, 0, <0. M
- * *
- * KEYWORDS: M
- * InptEvalCompareObject M
- *****************************************************************************/
- ParseTree *InptEvalCompareObject(ParseTree *Root,
- ParseTree *Left,
- ParseTree *Right,
- InptPrsrEvalErrType *IError,
- char *CError)
- {
- int OnlyEquality = TRUE;
- RealType
- Cmp = 0.0;
-
- if (Left -> PObj -> ObjType != Right -> PObj -> ObjType) {
- *IError = IE_ERR_INCOMPARABLE_TYPES;
- strcpy(CError, "");
- return NULL;
- }
-
- switch (Left -> PObj -> ObjType) {
- case IP_OBJ_NUMERIC:
- Cmp = SIGN(Left -> PObj -> U.R - Right -> PObj -> U.R);
- OnlyEquality = FALSE;
- break;
- case IP_OBJ_POINT:
- Cmp = PT_APX_EQ(Left -> PObj -> U.Pt,
- Right -> PObj -> U.Pt) == 0;
- break;
- case IP_OBJ_VECTOR:
- Cmp = PT_APX_EQ(Left -> PObj -> U.Vec,
- Right -> PObj -> U.Vec) == 0;
- break;
- case IP_OBJ_PLANE:
- Cmp = PLANE_APX_EQ(Left -> PObj -> U.Plane,
- Right -> PObj -> U.Plane) == 0;
- break;
- case IP_OBJ_STRING:
- Cmp = strcmp(Left -> PObj -> U.Str, Right -> PObj -> U.Str);
- OnlyEquality = FALSE;
- break;
- default:
- break;
- }
-
- switch (Root -> NodeKind) {
- case CMP_EQUAL:
- Cmp = Cmp == 0.0;
- break;
- case CMP_NOTEQUAL:
- Cmp = Cmp != 0.0;
- break;
- case CMP_LSEQUAL:
- case CMP_GTEQUAL:
- case CMP_LESS:
- case CMP_GREAT:
- if (OnlyEquality) {
- *IError = IE_ERR_ONLYEQUALITY_TEST;
- strcpy(CError, "");
- return NULL;
- }
- else {
- switch (Root -> NodeKind) {
- case CMP_LSEQUAL:
- Cmp = Cmp <= 0.0;
- break;
- case CMP_GTEQUAL:
- Cmp = Cmp >= 0.0;
- break;
- case CMP_LESS:
- Cmp = Cmp < 0.0;
- break;
- case CMP_GREAT:
- Cmp = Cmp > 0.0;
- break;
- }
- }
- break;
- default:
- IritFatalError("A comparison operator expected.");
- break;
- }
-
- Root -> PObj = GenNUMValObject(Cmp);
- return Root;
- }
-
- /*****************************************************************************
- * DESCRIPTION: M
- * Executes the IF expression. M
- * *
- * PARAMETERS: M
- * Cond: To evaluate in the IF sentence. M
- * CondTrue: Optional, execute if Cond is TRUE. M
- * CondFalse: Optional, execute if Cond is FALSE. M
- * *
- * RETURN VALUE: M
- * void M
- * *
- * KEYWORDS: M
- * InptEvalIfCondition M
- *****************************************************************************/
- void InptEvalIfCondition(ParseTree *Cond,
- ParseTree *CondTrue,
- ParseTree *CondFalse)
- {
- if ((Cond = InptPrsrEvalTree(Cond, 1)) != NULL &&
- Cond -> PObj != NULL &&
- IP_IS_NUM_OBJ(Cond -> PObj)) {
- if (APX_EQ(Cond -> PObj -> U.R, 0.0)) {
- if (CondFalse != NULL)
- InptPrsrEvalTree(CondFalse, 0);
- }
- else {
- if (CondTrue != NULL)
- InptPrsrEvalTree(CondTrue, 0);
- }
- }
- else {
- IPGlblEvalError = IE_ERR_IF_HAS_NO_COND;
- strcpy(IPGlblCharData, "");
- }
- }
-
- /*****************************************************************************
- * DESCRIPTION: M
- * Executes the FOR expression loop. M
- * As InptPrsrEvalTree routine is destructive on its input tree, we must M
- * make a copy of the body before executing it! M
- * We wish we could access the loop variable directly, but the user might M
- * free them in the loop - so me must access it by name. M
- * *
- * PARAMETERS: M
- * PStart: Initailization expression. M
- * PInc: Increment expression. M
- * PEnd: Termination expression. M
- * PBody: Body of loop expression. M
- * *
- * RETURN VALUE: M
- * void M
- * *
- * KEYWORDS: M
- * InptEvalForLoop M
- *****************************************************************************/
- void InptEvalForLoop(ParseTree *PStart,
- ParseTree *PInc,
- ParseTree *PEnd,
- ParseTree *PBody)
- {
- int i, NumOfExpr, LoopCount;
- char
- *LoopVarName = NULL;
- RealType LoopVar, StartVal, Increment, EndVal;
- ParseTree *PTemp;
- IPObjectStruct *PLoopVar;
-
- /* Find the only two cases where loop variable is allowed - when then */
- /* given starting value is a parameter, or assignment to parameter... */
- if (PStart -> NodeKind == PARAMETER)
- LoopVarName = PStart -> PObj -> Name;
- else if (PStart -> NodeKind == EQUAL &&
- PStart -> Left -> NodeKind == PARAMETER) {
- LoopVarName = PStart -> Left -> PObj -> Name;
- /* Rebind the iteration variable to body - it might be new: */
- RebindVariable(PBody, PStart -> Left -> PObj, FALSE);
- if (GetObject(LoopVarName) == NULL) /* It is really new. */
- PStart -> Left -> PObj -> Count++;
- }
-
- PStart = InptPrsrEvalTree(PStart, 1); /* Evaluate starting value. */
- PInc = InptPrsrEvalTree(PInc, 1); /* Evaluate increment value. */
- PEnd = InptPrsrEvalTree(PEnd, 1); /* Evaluate end value. */
- if (IPGlblEvalError ||
- PStart == NULL || PInc == NULL || PEnd == NULL)
- return;
- StartVal = PStart -> PObj -> U.R;
- Increment = PInc -> PObj -> U.R;
- EndVal = PEnd -> PObj -> U.R;
-
- /* Num. of expr. in the body. */
- NumOfExpr = InptEvalCountNumExpressions(PBody);
- for (LoopVar = StartVal, LoopCount = 0;
- APX_EQ(LoopVar, EndVal) ||
- (Increment > 0 ? LoopVar <= EndVal : LoopVar >= EndVal);
- LoopVar += Increment, LoopCount++) {
- if (IPGlblEvalError || GlblFatalError)
- return;
- if (LoopVarName != NULL) {
- if ((PLoopVar = GetObject(LoopVarName)) != NULL &&
- IP_IS_NUM_OBJ(PLoopVar))
- PLoopVar -> U.R = LoopVar; /* Update loop var. */
- else {
- IPGlblEvalError = IE_ERR_MODIF_ITER_VAR;
- strcpy(IPGlblCharData, LoopVarName);
- }
- }
-
- for (i = 0; i < NumOfExpr; i++) {
- PTemp = InptEvalFetchExpression(PBody, i, NumOfExpr);
- if (LoopCount == 0 && InptPrsrTypeCheck(PTemp, 0) == ERROR_EXPR)
- return;
- else {
- if (LoopVar == EndVal) {
- /* Use the original tree. Note we must evaluate the */
- /* original tree at least once as ObjType's are updated. */
- InptPrsrEvalTree(PTemp, 0); /* Eval as its top level... */
- }
- else {
- PTemp = InptPrsrCopyTree(PTemp);
- InptPrsrEvalTree(PTemp, 0); /* Eval as its top level... */
- InptPrsrFreeTree(PTemp); /* Not needed any more. */
- }
- }
- }
- }
- }
-
- /*****************************************************************************
- * DESCRIPTION: *
- * Rebinds a variable - given a tree, scan it and update each occurance of *
- * that variable to point to PObj. *
- * *
- * PARAMETERS: *
- * Root: Tree to rebind. *
- * PObj: Variable to rebind to. *
- * FreeOld: Should we free old instance of PObj? *
- * *
- * RETURN VALUE: *
- * void *
- *****************************************************************************/
- static void RebindVariable(ParseTree *Root, IPObjectStruct *PObj, int FreeOld)
- {
- if (Root == NULL)
- return;
-
- if (IS_FUNCTION(Root -> NodeKind)) { /* All the functions. */
- RebindVariable(Root -> Right, PObj, FreeOld);
- return;
- }
-
- switch (Root -> NodeKind) {
- case DIV:
- case MINUS:
- case MULT:
- case PLUS:
- case POWER:
-
- case COMMA:
- case COLON:
- case EQUAL:
- case CMP_EQUAL:
- case CMP_NOTEQUAL:
- case CMP_LSEQUAL:
- case CMP_GTEQUAL:
- case CMP_LESS:
- case CMP_GREAT:
- case BOOL_OR:
- case BOOL_AND:
- RebindVariable(Root -> Right, PObj, FreeOld);
- RebindVariable(Root -> Left, PObj, FreeOld);
- return;
-
- case UNARMINUS:
- case BOOL_NOT:
- RebindVariable(Root -> Right, PObj, FreeOld);
- return;
-
- case NUMBER:
- return;
-
- case PARAMETER:
- case STRING:
- if (strcmp(Root -> PObj -> Name, PObj -> Name) == 0) {
- if (FreeOld && IP_IS_UNDEF_OBJ(Root -> PObj))
- IPFreeObject(Root -> PObj);
- Root -> PObj = PObj;
- }
- return;
-
- case TOKENSTART:
- return;
-
- default:
- IritFatalError("RebindVariable: Undefined ParseTree type, exit");
- }
- }
-
- /*****************************************************************************
- * DESCRIPTION: M
- * Marks all undefined objects in bindings as "to be assigned". M
- * *
- * PARAMETERS: M
- * Root: Tree to rebind. M
- * *
- * RETURN VALUE: M
- * void M
- * *
- * KEYWORDS: M
- * IritPrsrMarkToBeAssigned M
- *****************************************************************************/
- void IritPrsrMarkToBeAssigned(ParseTree *Root)
- {
- if (Root == NULL)
- return;
-
- if (IS_FUNCTION(Root -> NodeKind)) { /* All the functions. */
- IritPrsrMarkToBeAssigned(Root -> Right);
- return;
- }
-
- switch (Root -> NodeKind) {
- case DIV:
- case MINUS:
- case MULT:
- case PLUS:
- case POWER:
-
- case COMMA:
- case COLON:
- case EQUAL:
- case CMP_EQUAL:
- case CMP_NOTEQUAL:
- case CMP_LSEQUAL:
- case CMP_GTEQUAL:
- case CMP_LESS:
- case CMP_GREAT:
- case BOOL_OR:
- case BOOL_AND:
- IritPrsrMarkToBeAssigned(Root -> Right);
- IritPrsrMarkToBeAssigned(Root -> Left);
- return;
-
- case UNARMINUS:
- case BOOL_NOT:
- IritPrsrMarkToBeAssigned(Root -> Right);
- return;
-
- case NUMBER:
- case STRING:
- return;
-
- case PARAMETER:
- if (IP_IS_UNDEF_OBJ(Root -> PObj))
- SET_TO_BE_ASSIGN_OBJ(Root -> PObj);
- return;
-
- case TOKENSTART:
- return;
-
- default:
- IritFatalError("IritPrsrMarkToBeAssigned: Undefined ParseTree type, exit");
- }
- }
-
- /*****************************************************************************
- * DESCRIPTION: M
- * Creates an OBJECT LIST object out of all parameters. M
- * *
- * PARAMETERS: M
- * PObjParams: To insert into one list object. M
- * *
- * RETURN VALUE: M
- * IPObjectStruct *: A list object with all the parameters, or NULL if M
- * error. M
- * *
- * KEYWORDS: M
- * InptEvalGenObjectList M
- *****************************************************************************/
- IPObjectStruct *InptEvalGenObjectList(ParseTree *PObjParams)
- {
- int i, NumOfParams;
- ParseTree *Param;
- IPObjectStruct *PObj;
-
- NumOfParams = InptEvalCountNumParameters(PObjParams);
-
- PObj = IPAllocObject("", IP_OBJ_LIST_OBJ, NULL);
-
- for (i = 0; i < NumOfParams; i++) {
- if ((Param = InptPrsrEvalTree(InptEvalFetchParameter(PObjParams, i,
- NumOfParams),
- 1)) == NULL) {
- IPFreeObject(PObj);
- return NULL;
- }
-
- if (IP_IS_UNDEF_OBJ(Param -> PObj)) {
- IPGlblEvalError = IE_ERR_IP_OBJ_UNDEFINED;
- strcpy(IPGlblCharData, Param -> PObj -> Name);
- ListObjectInsert(PObj, i, NULL);
- IPFreeObject(PObj);
- return NULL;
- }
-
- ListObjectInsert(PObj, i, Param -> PObj);
- Param -> PObj -> Count++; /* Increase number of references. */
- }
-
- ListObjectInsert(PObj, NumOfParams, NULL);
-
- return PObj;
- }
-
- /*****************************************************************************
- * DESCRIPTION: M
- * Creates a Control Point Object out of all parameters. M
- * *
- * PARAMETERS: M
- * PObjParams: To create a control pointwith. M
- * *
- * RETURN VALUE: M
- * IPObjectStruct *: A control point object, or NULL if error. M
- * *
- * KEYWORDS: M
- * InptEvalCtlPtFromParams M
- *****************************************************************************/
- IPObjectStruct *InptEvalCtlPtFromParams(ParseTree *PObjParams)
- {
- int i, NumPts, NumOfParams, PtType,
- CoordCount = 0;
- ParseTree *Param;
- IPObjectStruct *PObj;
-
- NumOfParams = InptEvalCountNumParameters(PObjParams);
-
- PObj = IPAllocObject("", IP_OBJ_CTLPT, NULL);
-
- for (i = 0; i < NumOfParams; i++) {
- if ((Param = InptPrsrEvalTree(InptEvalFetchParameter(PObjParams, i,
- NumOfParams),
- 1)) == NULL) {
- IPFreeObject(PObj);
- return NULL;
- }
- if (!IP_IS_NUM_OBJ(Param -> PObj)) {
- IPGlblEvalError = IE_ERR_TYPE_MISMATCH;
- strcpy(IPGlblCharData, "Numeric data expected");
- IPFreeObject(PObj);
- return NULL;
- }
-
- if (i == 0) {
- PtType = PObj -> U.CtlPt.PtType =
- (CagdPointType) Param -> PObj -> U.R;
- switch (PtType) {
- case CAGD_PT_E1_TYPE:
- case CAGD_PT_E2_TYPE:
- case CAGD_PT_E3_TYPE:
- case CAGD_PT_E4_TYPE:
- case CAGD_PT_E5_TYPE:
- NumPts = CAGD_NUM_OF_PT_COORD(PtType);
- CoordCount = 1;
- break;
- case CAGD_PT_P1_TYPE:
- case CAGD_PT_P2_TYPE:
- case CAGD_PT_P3_TYPE:
- case CAGD_PT_P4_TYPE:
- case CAGD_PT_P5_TYPE:
- NumPts = CAGD_NUM_OF_PT_COORD(PtType) + 1;
- CoordCount = 0;
- break;
- default:
- IPGlblEvalError = IE_ERR_TYPE_MISMATCH;
- strcpy(IPGlblCharData,
- "E{1-5} or P{1-5} point type expected");
- IPFreeObject(PObj);
- return NULL;
- }
- if (NumOfParams - 1 != NumPts) {
- IPGlblEvalError = IE_ERR_NUM_PRM_MISMATCH;
- sprintf(IPGlblCharData, "%d expected", NumPts);
- IPFreeObject(PObj);
- return NULL;
- }
- }
- else
- PObj -> U.CtlPt.Coords[CoordCount++] = Param -> PObj -> U.R;
- }
-
- return PObj;
- }
-
- /*****************************************************************************
- * DESCRIPTION: *
- * Fetches the i'th expression out of a tree represent n expressions *
- * (0 <= i < n) seperated by colon. Similar to InptEvalFetchParameter rtn. *
- * *
- * PARAMETERS: *
- * Root: To fetch an expression from. *
- * i: The expression to fetch. *
- * n: Total number of expressions. *
- * *
- * RETURN VALUE: *
- * ParseTree *: Fetched expression. *
- *****************************************************************************/
- static ParseTree *InptEvalFetchExpression(ParseTree *Root, int i, int n)
- {
- int j;
-
- for (j = 0; j < i; j++)
- Root = Root -> Right;
-
- if (i == n - 1)
- return Root;
- else
- return Root -> Left;
- }
-
- /*****************************************************************************
- * DESCRIPTION: *
- * Count the number of expressions seperated by a COLON that are given in the *
- * tree ROOT. This routine is similar to InptEvalCountNumParameters. *
- * *
- * PARAMETERS: *
- * Root: To count number of expressions. *
- * *
- * RETURN VALUE: *
- * int: Number of expressions found. *
- *****************************************************************************/
- static int InptEvalCountNumExpressions(ParseTree *Root)
- {
- int i = 1;
-
- while (Root -> NodeKind == COLON) {
- i++;
- Root = Root -> Right;
- }
- return i;
- }
-
- /*****************************************************************************
- * DESCRIPTION: M
- * Handles a user defined function or procedure. M
- * A user defined function or proecdure is of the sepcial form: M
- * M
- * FuncName = {function | procedure}(Param1, Param2, ... , ParamN): V
- * LocalVar1: LocalVar2: ... LocalVarN: V
- * BodyExpr1: BodyExpr2: ... BodYExprN; V
- * M
- * This special form is decomposed into the following sections: M
- * 1. Parameter list as a list of IPObjectStructs. M
- * 2. Local variable list as a list of IPObjectStructs. M
- * 3. Body expression list as a Parsing tree. M
- * M
- * Defined function is saved in the global UserDefinedFuncList list. M
- * *
- * PARAMETERS: M
- * FuncDef: Parse tree of user defined function. M
- * *
- * RETURN VALUE: M
- * void M
- * *
- * KEYWORDS: M
- * InptEvalDefineFunc M
- *****************************************************************************/
- void InptEvalDefineFunc(ParseTree *FuncDef)
- {
- int NewFunc;
- char
- *Name = FuncDef -> Left -> Left -> PObj -> Name;
- ParseTree *Body, *PTmp;
- UserDefinedFuncDefType *UserFunc;
- IPObjectStruct *PObjTail, *PObj, *PObjTmp;
-
- for (UserFunc = UserDefinedFuncList;
- UserFunc != NULL;
- UserFunc = UserFunc -> Pnext) {
- if (strcmp(UserFunc -> FuncName, Name) == 0) {
- InptEvalDeleteFunc(UserFunc, FALSE);
- break;
- }
- }
- if (UserFunc == NULL) {
- UserFunc = (UserDefinedFuncDefType *)
- IritMalloc(sizeof(UserDefinedFuncDefType));
- UserFunc -> Params = UserFunc -> LocalVars = NULL;
- UserFunc -> Body = NULL;
- UserFunc -> NumParams = 0;
- NewFunc = TRUE;
- }
- else {
- InptEvalDeleteFunc(UserFunc, FALSE);
- NewFunc = FALSE;
- }
-
- /* Mark it as a function or procedure. */
- UserFunc -> IsFunction =
- FuncDef -> Left -> Right -> NodeKind == USERFUNCDEF;
-
- /* Get the function name. */
- PTmp = FuncDef -> Left -> Left;
- strncpy(UserFunc -> FuncName, Name, FUNC_NAME_LEN - 1);
- if (PTmp -> PObj -> ObjType == IP_OBJ_UNDEF) {
- /* Free it since not such object exists. */
- IPFreeObject(PTmp -> PObj);
- PTmp -> PObj = NULL;
- }
-
- /* Remove the object with function name and the return variable if they */
- /* were undefined and were created because of the parsing of function. */
- if ((PObj = GetObject(Name)) != NULL && PObj -> ObjType == IP_OBJ_UNDEF)
- DeleteObject(PObj, TRUE);
- if ((PObj = GetObject("RETURN")) != NULL &&
- PObj -> ObjType == IP_OBJ_UNDEF)
- DeleteObject(PObj, TRUE);
-
- /* Save the list of parameters. */
- for (PTmp = FuncDef -> Left -> Right -> Right, PObjTail = NULL;
- PTmp != NULL && PTmp -> NodeKind == COMMA;
- PTmp = PTmp -> Right) {
- if (PTmp -> Left -> NodeKind == PARAMETER) {
- Name = PTmp -> Left -> PObj -> Name;
-
- /* Make sure we do not have duplicated names in param. list. */
- for (PObjTmp = UserFunc -> Params;
- PObjTmp != NULL;
- PObjTmp = PObjTmp -> Pnext) {
- if (strcmp(Name, PObjTmp -> Name) == 0) {
- IPGlblEvalError = IE_ERR_IP_USERFUNC_DUP_VAR;
- sprintf(IPGlblCharData, "Func \"%s\", Variable \"%s\"",
- UserFunc -> FuncName, Name);
- InptEvalDeleteFunc(UserFunc, TRUE);
- return;
- }
- }
-
- /* Create a new object with same name but undefined type. */
- if (UserFunc -> Params == NULL)
- UserFunc -> Params = PObjTail =
- IPAllocObject(Name, IP_OBJ_UNDEF, NULL);
- else {
- PObjTail -> Pnext = IPAllocObject(Name, IP_OBJ_UNDEF, NULL);
- PObjTail = PObjTail -> Pnext;
- }
-
- /* Make sure there is no undefined object by that name in global */
- /* list from the parsing stage. If so - remove it. */
- if ((PObj = GetObject(Name)) != NULL &&
- PObj -> ObjType == IP_OBJ_UNDEF)
- DeleteObject(PObj, TRUE);
- }
- UserFunc -> NumParams++;
- }
- if (PTmp != NULL && PTmp -> NodeKind == PARAMETER) {
- Name = PTmp -> PObj -> Name;
-
- /* Make sure we do not have duplicated names in param. list. */
- for (PObjTmp = UserFunc -> Params;
- PObjTmp != NULL;
- PObjTmp = PObjTmp -> Pnext) {
- if (strcmp(Name, PObjTmp -> Name) == 0) {
- IPGlblEvalError = IE_ERR_IP_USERFUNC_DUP_VAR;
- sprintf(IPGlblCharData, "Func \"%s\", Variable \"%s\"",
- UserFunc -> FuncName, Name);
- InptEvalDeleteFunc(UserFunc, TRUE);
- return;
- }
- }
-
- /* Create a new object with same name but undefined type. */
- if (UserFunc -> Params == NULL)
- UserFunc -> Params = PObjTail =
- IPAllocObject(Name, IP_OBJ_UNDEF, NULL);
- else {
- PObjTail -> Pnext = IPAllocObject(Name, IP_OBJ_UNDEF, NULL);
- PObjTail = PObjTail -> Pnext;
- }
-
- /* Make sure there is no undefined object by that name in global */
- /* list from the parsing stage. If so - remove it. */
- if ((PObj = GetObject(Name)) != NULL &&
- PObj -> ObjType == IP_OBJ_UNDEF)
- DeleteObject(PObj, TRUE);
-
- UserFunc -> NumParams++;
- }
-
- /* Allocate a "return" variable. */
- UserFunc -> LocalVars = IPAllocObject("RETURN", IP_OBJ_UNDEF, NULL);
-
- /* Isolate the body of the function while saving the list of local vars. */
- for (Body = FuncDef -> Right, PTmp = FuncDef;
- Body -> NodeKind == COLON && Body -> Left -> NodeKind == PARAMETER;
- PTmp = Body, Body = Body -> Right) {
- Name = Body -> Left -> PObj -> Name;
-
- /* Make sure we do not have duplicated names in local vars list. */
- for (PObjTmp = UserFunc -> Params;
- PObjTmp != NULL;
- PObjTmp = PObjTmp -> Pnext) {
- if (strcmp(Name, PObjTmp -> Name) == 0) {
- IPGlblEvalError = IE_ERR_IP_USERFUNC_DUP_VAR;
- sprintf(IPGlblCharData, "Func \"%s\", Variable \"%s\"",
- UserFunc -> FuncName, Name);
- InptEvalDeleteFunc(UserFunc, TRUE);
- return;
- }
- }
- for (PObjTmp = UserFunc -> LocalVars;
- PObjTmp != NULL;
- PObjTmp = PObjTmp -> Pnext) {
- if (strcmp(Name, PObjTmp -> Name) == 0) {
- IPGlblEvalError = IE_ERR_IP_USERFUNC_DUP_VAR;
- sprintf(IPGlblCharData, "Func \"%s\", Variable \"%s\"",
- UserFunc -> FuncName, Name);
- InptEvalDeleteFunc(UserFunc, TRUE);
- return;
- }
- }
-
- /* We found a local variable decl. Copy it to local variable list. */
- /* Create a new object with same name but undefined type. */
- UserFunc -> LocalVars =
- IPAllocObject(Name, IP_OBJ_UNDEF, UserFunc -> LocalVars);
-
- /* Make sure there is no undefined object by that name in global */
- /* list from the parsing stage. If so - remove it. */
- if ((PObj = GetObject(Name)) != NULL &&
- PObj -> ObjType == IP_OBJ_UNDEF)
- DeleteObject(PObj, TRUE);
- }
-
- /* Disconnect body of the function and save it in function definition. */
- PTmp -> Right = NULL;
- UserFunc -> Body = Body;
-
- IritPrsrMarkToBeAssigned(Body);
- if (InptPrsrTypeCheck(Body, 0) != ERROR_EXPR) {
- if (NewFunc) {
- UserFunc -> Pnext = UserDefinedFuncList;
- UserDefinedFuncList = UserFunc;
- }
- }
- else
- InptEvalDeleteFunc(UserFunc, TRUE);
- }
-
- /*****************************************************************************
- * DESCRIPTION: *
- * Deletes/clears a user defined function structure. *
- * *
- * PARAMETERS: *
- * UserFunc: To remove from global list. *
- * DeleteSelf: If TRUE, free UserFunc as well. *
- * *
- * RETURN VALUE: *
- * void *
- *****************************************************************************/
- static void InptEvalDeleteFunc(UserDefinedFuncDefType *UserFunc,
- int DeleteSelf)
- {
- if (UserFunc -> Params != NULL)
- IPFreeObject(UserFunc -> Params);
- if (UserFunc -> LocalVars != NULL)
- IPFreeObject(UserFunc -> LocalVars);
- if (UserFunc -> Body != NULL)
- InptPrsrFreeTree(UserFunc -> Body);
-
- if (DeleteSelf) {
- if (UserFunc == UserDefinedFuncList)
- UserDefinedFuncList = UserDefinedFuncList->Pnext;
- else if (UserDefinedFuncList != NULL) {
- UserDefinedFuncDefType *TempFunc;
-
- for (TempFunc = UserDefinedFuncList;
- TempFunc -> Pnext != UserFunc && TempFunc -> Pnext != NULL;
- TempFunc = TempFunc -> Pnext);
- if (TempFunc && TempFunc->Pnext == UserFunc)
- TempFunc -> Pnext = TempFunc -> Pnext -> Pnext;
- }
- IritFree((VoidPtr) UserFunc);
- }
- else {
- UserFunc -> Params = UserFunc -> LocalVars = NULL;
- UserFunc -> Body = NULL;
- UserFunc -> NumParams = 0;
- }
- }
-
- /*****************************************************************************
- * DESCRIPTION: M
- * Sets the debug level of user function calls. M
- * *
- * PARAMETERS: M
- * DebugFuncLevel: Level of debugging user defined functions. M
- * *
- * RETURN VALUE: M
- * void M
- * *
- * KEYWORDS: M
- * InptPrsrDebugFuncLevel M
- *****************************************************************************/
- void InptPrsrDebugFuncLevel(int DebugFuncLevel)
- {
- GlblDebugFuncLevel = DebugFuncLevel;
- }
-
- /*****************************************************************************
- * DESCRIPTION: M
- * Invokes the evaluation of a user function. M
- * The following steps are performed: M
- * 1. A copy is made of parameter variables and local variables. M
- * 2. Binding of given parameters to function parameters. M
- * 3. The local variables and parameters are added to global variable list. M
- * *
- * PARAMETERS: M
- * Root: Parse tree of user defined function. M
- * InputParams: Parameters of the function. M
- * *
- * RETURN VALUE: M
- * ParseTree *: Evaluated result. M
- * *
- * KEYWORDS: M
- * InptEvalUserFunc M
- *****************************************************************************/
- ParseTree *InptEvalUserFunc(ParseTree *Root, ParseTree *InputParams[])
- {
- int i;
- char Line[LINE_LEN];
- UserDefinedFuncDefType
- *UserFunc = Root -> UserFunc;
- IPObjectStruct *PObj,
- *RetVal = NULL,
- *LastNewObj = NULL,
- *Params = CopyObjectList(UserFunc -> Params, TRUE),
- *ParamsLast = IritPrsrGetLastObj(Params),
- *LocalVars = CopyObjectList(UserFunc -> LocalVars, TRUE),
- *LocalVarsLast = IritPrsrGetLastObj(LocalVars),
- *EntryGlblObjList = GlblObjList;
- ParseTree
- *Body = InptPrsrCopyTree(UserFunc -> Body);
-
- if (GlblDebugFuncLevel > 0) {
- sprintf(Line, "***** DEBUG FUNC: invoking \"%s\"\n",
- UserFunc -> FuncName);
- WndwInputWindowPutStr(Line);
- }
-
- if (LocalVars) {
- /* Rebind local variables. */
- for (PObj = LocalVars, i = 0; PObj != NULL; PObj = PObj -> Pnext) {
- RebindVariable(Body, PObj, TRUE);
- }
-
- /* Chain the local variables into the global variable list. */
- LastNewObj = LocalVarsLast;
- LocalVarsLast -> Pnext = GlblObjList;
- GlblObjList = LocalVars;
- }
-
- if (Params) {
- /* Copy the parameter data into the parameters and rebind. */
- for (PObj = Params, i = 0; PObj != NULL; PObj = PObj -> Pnext, i++) {
- if (InputParams[i] -> PObj -> ObjType == IP_OBJ_UNDEF) {
- IPGlblEvalError = IE_ERR_IP_OBJ_UNDEFINED;
- sprintf(IPGlblCharData, "%s's parameter %d (%s).",
- UserFunc -> FuncName, i + 1, PObj -> Name);
- return NULL;
- }
- CopyObject(PObj, InputParams[i] -> PObj, FALSE);
- RebindVariable(Body, PObj, TRUE);
-
- if (GlblDebugFuncLevel > 2) {
- sprintf(Line, "***** DEBUG FUNC %s: parameter %d =\n",
- UserFunc -> FuncName, i);
- WndwInputWindowPutStr(Line);
- PrintObject(PObj);
- }
- }
-
- /* Chain the parameters into the global variable list. */
- if (LastNewObj == NULL)
- LastNewObj = ParamsLast;
- ParamsLast -> Pnext = GlblObjList;
- GlblObjList = Params;
- }
-
- if (GlblDebugFuncLevel > 4) {
- sprintf(Line, "***** DEBUG FUNC %s: global variable list =\n",
- UserFunc -> FuncName);
- WndwInputWindowPutStr(Line);
- PrintObjectList(GlblObjList);
- }
-
- /* Invoke the body of the function/procedure. */
- InptPrsrEvalTree(Body, 0);
-
- if (strcmp(LocalVarsLast -> Name, "RETURN") != 0)
- IritFatalError("Must have return value as last local\n");
- if (UserFunc -> IsFunction) {
- if (LocalVarsLast -> ObjType == IP_OBJ_UNDEF) {
- IPGlblEvalError = IE_ERR_USER_FUNC_NO_RETVAL;
- strcpy(IPGlblCharData, UserFunc -> FuncName);
- }
- else {
- RetVal = CopyObject(NULL, LocalVarsLast, FALSE);
-
- if (GlblDebugFuncLevel > 2) {
- sprintf(Line, "***** DEBUG FUNC %s: return value =\n",
- UserFunc -> FuncName);
- WndwInputWindowPutStr(Line);
- PrintObject(RetVal);
- }
- }
- }
- else {
- if (GlblDebugFuncLevel > 0) {
- sprintf(Line, "***** DEBUG FUNC: leaving \"%s\"\n",
- UserFunc -> FuncName);
- WndwInputWindowPutStr(Line);
- }
- }
-
- /* Restore previous state of global var list, and free the local */
- /* variables, parameters, and body. */
- LastNewObj ->Pnext = NULL;
- IPFreeObject(GlblObjList);
- GlblObjList = EntryGlblObjList;
- InptPrsrFreeTree(Body);
-
- if (RetVal == NULL)
- return NULL;
- else {
- Root -> PObj = RetVal;
- return Root;
- }
- }
-